home *** CD-ROM | disk | FTP | other *** search
/ Chip 2007 January, February, March & April / Chip-Cover-CD-2007-02.iso / Pakiet bezpieczenstwa / mini Pentoo LiveCD 2006.1 / mpentoo-2006.1.iso / livecd.squashfs / usr / lib / glibmm-2.4 / proc / pm / Util.pm < prev    next >
Encoding:
Perl POD Document  |  2006-04-20  |  2.6 KB  |  114 lines
  1. # gtkmm - Util module
  2. #
  3. # Copyright 2001 Free Software Foundation
  4. #
  5. # This program is free software; you can redistribute it and/or modify
  6. # it under the terms of the GNU General Public License as published by
  7. # the Free Software Foundation; either version 2 of the License, or 
  8. # (at your option) any later version.
  9. #
  10. # This program is distributed in the hope that it will be useful,
  11. # # but WITHOUT ANY WARRANTY; without even the implied warranty of
  12. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the 
  13. # GNU General Public License for more details. 
  14. #
  15. # You should have received a copy of the GNU General Public License
  16. # along with this program; if not, write to the Free Software
  17. # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
  18. #
  19. #
  20. # This file holds basic functions used throughout gtkmmproc modules.
  21. # Functions in this module are exported so there is no need to 
  22. # request them by module name.
  23. #
  24. package Util;
  25. use strict;
  26. use warnings;
  27.  
  28. BEGIN {
  29.      use Exporter   ();
  30.      our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
  31.  
  32.      # set the version for version checking
  33.      $VERSION     = 1.00;
  34.      @ISA         = qw(Exporter);
  35.      @EXPORT      = qw(&string_unquote &string_trim &string_canonical
  36.                        &trace &unique);
  37.      %EXPORT_TAGS = ( );
  38.  
  39.      # your exported package globals go here,
  40.      # as well as any optionally exported functions
  41.      #@EXPORT_OK   = qw($Var1 %Hashit &func3);
  42.      }
  43. our @EXPORT_OK;
  44.  
  45.  
  46. #$ string_unquote($string)
  47. # Removes leading and trailing quotes.
  48. sub string_unquote($)
  49. {
  50.     my ($str) = @_;
  51.     
  52.     $str =~ s/^['`"]// ;
  53.     $str =~ s/['`"]$// ;
  54.  
  55.     return $str;
  56. }
  57.          
  58. # $ string_trim($string)
  59. # Removes leading and trailing white space.
  60. sub string_trim($)
  61. {
  62.   ($_) = @_;
  63.   s/^\s+//;
  64.   s/\s+$//;
  65.   return $_;
  66. }
  67.  
  68. #  $ string_canonical($string)
  69. # Convert - to _.
  70. sub string_canonical($)
  71. {
  72.   ($_) = @_;
  73.   s/-/_/g ; # g means 'replace all'
  74.   s/\//_/g ; # g means 'replace all'
  75.   return $_;
  76. }
  77.  
  78. #
  79. #  Back tracing utility.  
  80. #    Prints the call stack.
  81. #
  82. #  void trace()
  83. sub trace()
  84. {
  85.   my ($package, $filename, $line, $subroutine, $hasargs,
  86.    $wantarray, $evaltext, $is_require, $hints, $bitmask) = caller(1);
  87.  
  88.   no warnings qw(uninitialized);
  89.  
  90.   my $i = 2;
  91.   print "Trace on ${subroutine} called from ${filename}:${line}\n";
  92.   while (1)
  93.   {
  94.     ($package, $filename, $line, $subroutine) = caller($i);
  95.     $i++;
  96.     next if ($line eq "");
  97.     print "  From ${subroutine} call from ${filename}:${line}\n";
  98.   }
  99. }
  100.  
  101. sub unique(@)
  102. {
  103.   my %hash;
  104.   foreach (@_)
  105.   {
  106.     $hash{$_}=1;
  107.   }
  108.  
  109.   return keys %hash;
  110. }
  111.  
  112. 1; # indicate proper module load.
  113.  
  114.